home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / system / 4utils84.zip / scanarjf.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-08  |  10KB  |  267 lines
  1. UNIT ScanARJFiles;
  2. {$V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992, 1994 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the extraction of file names in .ARJ files.
  29.    ----------------------------------------------------------------------- *)
  30.  
  31. INTERFACE USES Dos, Globals;
  32.  
  33. PROCEDURE SearchInARJFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  34.                           VAR Dir: PathStr; VAR arjsearch: SearchRec);
  35. PROCEDURE ShowCompARJFileData(VAR search,arjsearch: SearchRec;VAR Path: PathStr;
  36.                               csize: LONGINT);
  37.  
  38. VAR OldARJFileName: PathStr;
  39.  
  40. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  41.  
  42. CONST ARJMagicHeader = $EA60;
  43.  
  44. PROCEDURE SearchInARJFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  45.                           VAR Dir: PathStr; VAR arjsearch: SearchRec);
  46.  
  47. VAR i          : WORD;
  48.     k, dummy   : BYTE;
  49.     ARJFileName: NameExtStr;
  50.     sig        : LONGINT;
  51.     hsize      : WORD;
  52.     flags      : BYTE;
  53.     c          : CHAR;
  54.  
  55. BEGIN (* SearchInARJFile *)
  56.  Assign(f,arjsearch.Name); Reset(f,1);
  57.  BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0; FilePtr := 0;
  58.  
  59.  sig := LONGINT(ReadByte) SHL  8 + LONGINT(ReadByte);
  60.  (* header id (main and local file) = 0xEA60 or 60000U *)
  61.  IF sig <> ARJMagicHeader THEN
  62.   BEGIN
  63.    WriteLn(output,'ARJ file error: magic file header signature missing!');
  64.    WriteLn(output);
  65.   END;
  66.  
  67.  hsize := 1;
  68.  REPEAT
  69.   (* header id (main and local file) = 0xEA60 or 60000U *)
  70.   REPEAT
  71.    REPEAT
  72.     sig := ReadByte;
  73.     IF BufPtr >= BufSize THEN
  74.      BEGIN
  75.       BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
  76.      END;
  77.    UNTIL (sig = Lo(ARJMagicHeader)) OR (BufPtr > BytesRead);
  78.    REPEAT
  79.     sig := ReadByte;
  80.     IF BufPtr >= BufSize THEN
  81.      BEGIN
  82.       BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
  83.      END;
  84.    UNTIL (sig = Hi(ARJMagicHeader)) OR (BufPtr > BytesRead);
  85.   UNTIL (sig = Hi(ARJMagicHeader)) OR (BufPtr > BytesRead);
  86.  
  87.   IF sig = Hi(ARJMagicHeader) THEN
  88.    BEGIN
  89.     hsize := LONGINT(ReadByte) SHL 8 + LONGINT(ReadByte);
  90.     (* 2   basic header size (from 'first_hdr_size' thru 'comment' below)
  91.        = first_hdr_size + strlen(filename) + 1 + strlen(comment) + 1
  92.        = 0 if end of archive *)
  93.     IF hsize > 0 THEN
  94.      BEGIN
  95.       FOR i := 1 TO 4 DO dummy := ReadByte;
  96.       (* 1   first_hdr_size (size up to and including 'extra data')
  97.          1   archiver version number
  98.          1   minimum archiver version to extract
  99.          1   host OS   (0 = MSDOS, 1 = PRIMOS, 2 = UNIX, 3 = AMIGA, 4 = MAC-OS)
  100.                (5 = OS/2, 6 = APPLE GS, 7 = ATARI ST, 8 = NEXT)
  101.                (9 = VAX VMS) *)
  102.       flags := ReadByte;
  103.       (* 1   arj flags (0x01 = GARBLED_FLAG) indicates passworded file
  104.                (0x02 = RESERVED)
  105.                (0x04 = VOLUME_FLAG)  indicates continued file to next
  106.                                              volume (file is split)
  107.                (0x08 = EXTFILE_FLAG) indicates file starting position
  108.                                              field (for split files)
  109.                        (0x10 = PATHSYM_FLAG) indicates filename translated
  110.                          ("\" changed to "/")
  111.                        (0x20 = BACKUP_FLAG)  indicates file marked as backup *)
  112.       FOR i := 1 TO 3 DO dummy := ReadByte;
  113.       (* 1   method    (0 = stored, 1 = compressed most ... 4 compressed fastest)
  114.          1   file type (0 = binary, 1 = 7-bit text)
  115.                (3 = directory, 4 = volume label)
  116.          1   reserved *)
  117.  
  118.       Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  119.       (* 4   date time modified *)
  120.       csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  121.       (* 4   compressed size *)
  122.       Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  123.       (* 4   original size (this will be different for text mode compression) *)
  124.  
  125.       FOR i := 1 TO 5 DO dummy := ReadByte;
  126.       (* 4   original file's CRC
  127.          2   filespec position in filename *)
  128.       Search.Attr := ReadByte; (* dummy := ReadByte; *)
  129.       (* 2   file access mode
  130.          2   host data (currently not used) *)
  131.       IF flags AND $08 <> $08 THEN
  132.        FOR i := 1 TO 4 DO dummy := ReadByte;
  133.       (* ?   extra data
  134.          4 bytes for extended file starting position when used
  135.          (this is present when EXTFILE_FLAG is set) *)
  136.  
  137.       WITH Search DO
  138.        BEGIN
  139.         name  := ''; c := 'x';
  140.         WHILE c <> #0 DO
  141.          BEGIN
  142.           c := Chr(ReadByte); name := name+DownCase(c);
  143.          END;
  144.         k := Length(Name); IF Name[k] = #0 THEN Delete(Name,k,1);
  145.        END;
  146.       (* ?   filename (null-terminated string) *)
  147.       (* ?   comment  (null-terminated string) ... *)
  148.  
  149.       FOR k := 1 TO FileSpecs DO
  150.        BEGIN
  151.         FSplit(FileSpec[k],Path,name,ext);
  152.         WHILE Length(name) < 8 DO name := name+' ';
  153.         IF Ext = '' THEN Ext := '.   '
  154.         ELSE
  155.          WHILE Length(ext) < 4 DO ext := ext+' ';
  156.  
  157.         i := Pos('*',name);
  158.         IF  i > 0 THEN
  159.          WHILE i <= 8 DO
  160.           BEGIN
  161.            name[i] := '?'; INC(i);
  162.           END;
  163.  
  164.         i := Pos('*',ext);
  165.         IF  i > 0 THEN
  166.          WHILE i <= 4 DO
  167.           BEGIN
  168.            ext[i] := '?'; INC(i);
  169.           END;
  170.         FileSpec[k] := Path+name+ext;
  171.  
  172.         FSplit(Search.Name,Path,name,ext);
  173.         WHILE Length(name) < 8 DO name := name +' ';
  174.         IF Ext = '' THEN Ext := '.   '
  175.         ELSE
  176.          WHILE Length(ext)      < 4 DO ext := ext+' ';
  177.         ARJFileName:= Path+name+ext;
  178.  
  179.         i := 1;
  180.         WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = ARJFileName[i])) AND
  181.                (i<12) DO
  182.          INC(i);
  183.  
  184.         IF ((searchdesc = '') AND
  185.             ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  186.              (FileSpec[k][i] = '?') OR (FileSpec[k][i] = ARJFileName[i])) THEN
  187.          ShowCompARJFileData(search,arjsearch,Dir,csize);
  188.        END;
  189.  
  190.       INC(BufPtr,csize); INC(FilePtr,csize);
  191.       IF BufPtr > BufSize THEN
  192.        BEGIN
  193.         Seek(f,FilePtr);
  194.         BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
  195.        END;
  196.      END;
  197.    END;
  198.  UNTIL hsize = 0;
  199.  
  200.  Close(f);
  201. END; (* SearchInARJFile *)
  202.  
  203. PROCEDURE ShowCompARJFileData(VAR search,arjsearch: SearchRec;VAR Path: PathStr;
  204.                               csize: LONGINT);
  205.  
  206. BEGIN
  207.  IF NOT BareOutput THEN
  208.   BEGIN
  209.    IF FileCount = 0 THEN
  210.     BEGIN
  211.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  212.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  213.     END;
  214.  
  215.    IF arjsearch.Name <> OldARJFileName THEN
  216.     BEGIN
  217.      DownString(arjsearch.Name); OldARJFileName := arjsearch.Name;
  218.  
  219.      InfoArray[0] := @arjsearch.Name;
  220.  
  221.      SizeStr := FormattedLongIntStr(arjsearch.Size,8);
  222.      InfoArray[1] := @SizeStr;
  223.  
  224.      UnpackTime(arjsearch.Time,DateRec);
  225.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  226.      InfoArray[2] := @Date;
  227.      InfoArray[3] := @Time;
  228.  
  229.      AttrStr := '....';
  230.      IF arjSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  231.      IF arjSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  232.      IF arjSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  233.      IF arjSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  234.      InfoArray[4] := @AttrStr;
  235.  
  236.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  237.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  238.     END;
  239.  
  240.    InfoArray[0] := @search.Name;
  241.  
  242.    SizeStr := FormattedLongIntStr(search.Size,8);
  243.    InfoArray[1] := @SizeStr;
  244.  
  245.    UnpackTime(search.Time,DateRec);
  246.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  247.    InfoArray[2] := @Date;
  248.    InfoArray[3] := @Time;
  249.  
  250. (*   AttrStr := '----';
  251.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  252.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  253.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  254.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  255.                                           ELSE AttrStr[4] := 'w';
  256.    InfoArray[4] := LONGINT(@AttrStr);
  257.  
  258.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  259.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  260.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  261.  
  262.    INC(TotalSize,csize); INC(DirSize,csize);
  263.    INC(TotalFileCount);  INC(FileCount);
  264.   END;
  265. END; (* ShowFileData *)
  266.  
  267. END.